<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
 <head>
  <title>ieeeck.f</title>
 <meta name="generator" content="emacs 21.3.1; htmlfontify 0.20">
<style type="text/css"><!-- 
body { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default   { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default a { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.comment   { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.comment a { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
 --></style>

 </head>
  <body>

<pre>
      INTEGER          FUNCTION <a name="IEEECK.1"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a>( ISPEC, ZERO, ONE )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  -- LAPACK auxiliary routine (version 3.1) --
</span><span class="comment">*</span><span class="comment">     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment">     November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Scalar Arguments ..
</span>      INTEGER            ISPEC
      REAL               ONE, ZERO
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Purpose
</span><span class="comment">*</span><span class="comment">  =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="IEEECK.15"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> is called from the <a name="ILAENV.15"></a><a href="ilaenv.f.html#ILAENV.1">ILAENV</a> to verify that Infinity and
</span><span class="comment">*</span><span class="comment">  possibly NaN arithmetic is safe (i.e. will not trap).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Arguments
</span><span class="comment">*</span><span class="comment">  =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ISPEC   (input) INTEGER
</span><span class="comment">*</span><span class="comment">          Specifies whether to test just for inifinity arithmetic
</span><span class="comment">*</span><span class="comment">          or whether to test for infinity and NaN arithmetic.
</span><span class="comment">*</span><span class="comment">          = 0: Verify infinity arithmetic only.
</span><span class="comment">*</span><span class="comment">          = 1: Verify infinity and NaN arithmetic.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ZERO    (input) REAL
</span><span class="comment">*</span><span class="comment">          Must contain the value 0.0
</span><span class="comment">*</span><span class="comment">          This is passed to prevent the compiler from optimizing
</span><span class="comment">*</span><span class="comment">          away this code.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ONE     (input) REAL
</span><span class="comment">*</span><span class="comment">          Must contain the value 1.0
</span><span class="comment">*</span><span class="comment">          This is passed to prevent the compiler from optimizing
</span><span class="comment">*</span><span class="comment">          away this code.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  RETURN VALUE:  INTEGER
</span><span class="comment">*</span><span class="comment">          = 0:  Arithmetic failed to produce the correct answers
</span><span class="comment">*</span><span class="comment">          = 1:  Arithmetic produced the correct answers
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Local Scalars ..
</span>      REAL               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
     $                   NEGZRO, NEWZRO, POSINF
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span>      <a name="IEEECK.46"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 1
<span class="comment">*</span><span class="comment">
</span>      POSINF = ONE / ZERO
      IF( POSINF.LE.ONE ) THEN
         <a name="IEEECK.50"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      NEGINF = -ONE / ZERO
      IF( NEGINF.GE.ZERO ) THEN
         <a name="IEEECK.56"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      NEGZRO = ONE / ( NEGINF+ONE )
      IF( NEGZRO.NE.ZERO ) THEN
         <a name="IEEECK.62"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      NEGINF = ONE / NEGZRO
      IF( NEGINF.GE.ZERO ) THEN
         <a name="IEEECK.68"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      NEWZRO = NEGZRO + ZERO
      IF( NEWZRO.NE.ZERO ) THEN
         <a name="IEEECK.74"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      POSINF = ONE / NEWZRO
      IF( POSINF.LE.ONE ) THEN
         <a name="IEEECK.80"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      NEGINF = NEGINF*POSINF
      IF( NEGINF.GE.ZERO ) THEN
         <a name="IEEECK.86"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      POSINF = POSINF*POSINF
      IF( POSINF.LE.ONE ) THEN
         <a name="IEEECK.92"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Return if we were only asked to check infinity arithmetic
</span><span class="comment">*</span><span class="comment">
</span>      IF( ISPEC.EQ.0 )
     $   RETURN
<span class="comment">*</span><span class="comment">
</span>      NAN1 = POSINF + NEGINF
<span class="comment">*</span><span class="comment">
</span>      NAN2 = POSINF / NEGINF
<span class="comment">*</span><span class="comment">
</span>      NAN3 = POSINF / POSINF
<span class="comment">*</span><span class="comment">
</span>      NAN4 = POSINF*ZERO
<span class="comment">*</span><span class="comment">
</span>      NAN5 = NEGINF*NEGZRO
<span class="comment">*</span><span class="comment">
</span>      NAN6 = NAN5*0.0
<span class="comment">*</span><span class="comment">
</span>      IF( NAN1.EQ.NAN1 ) THEN
         <a name="IEEECK.117"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( NAN2.EQ.NAN2 ) THEN
         <a name="IEEECK.122"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( NAN3.EQ.NAN3 ) THEN
         <a name="IEEECK.127"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( NAN4.EQ.NAN4 ) THEN
         <a name="IEEECK.132"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( NAN5.EQ.NAN5 ) THEN
         <a name="IEEECK.137"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( NAN6.EQ.NAN6 ) THEN
         <a name="IEEECK.142"></a><a href="ieeeck.f.html#IEEECK.1">IEEECK</a> = 0
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      RETURN
      END

</pre>

 </body>
</html>
